VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsRunProcess"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Declare Function CreateProcess Lib "kernel32.dll" Alias "CreateProcessA" (ByVal lpApplicationName As String, ByVal lpCommandLine As String, ByRef lpProcessAttributes As Any, ByRef lpThreadAttributes As Any, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByRef lpEnvironment As Any, ByVal lpCurrentDriectory As String, ByRef lpStartupInfo As STARTUPINFO, ByRef lpProcessInformation As PROCESS_INFORMATION) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32.dll" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32.dll" (ByVal hProcess As Long, ByRef lpExitCode As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32.dll" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function CreatePipe Lib "kernel32.dll" (ByRef phReadPipe As Long, ByRef phWritePipe As Long, ByRef lpPipeAttributes As SECURITY_ATTRIBUTES, ByVal nSize As Long) As Long
Private Declare Function SetHandleInformation Lib "kernel32.dll" (ByVal hObject As Long, ByVal dwMask As Long, ByVal dwFlags As Long) As Long
Private Declare Function AllocConsole Lib "kernel32.dll" () As Long
Private Declare Function GetStdHandle Lib "kernel32.dll" (ByVal nStdHandle As Long) As Long

Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

Private Type STARTUPINFO
    cb As Long
    lpReserved As Long
    lpDesktop As Long
    lpTitle As Long
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Byte
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessId As Long
    dwThreadId As Long
End Type

Private Const WAIT_TIMEOUT As Long = 258&
Private Const STATUS_PENDING As Long = &H103
Private Const STILL_ACTIVE As Long = STATUS_PENDING
Private Const STARTF_USESTDHANDLES As Long = &H100
Private Const HANDLE_FLAG_INHERIT As Long = &H1
Private Const STD_OUTPUT_HANDLE As Long = -11&
Private Const STD_ERROR_HANDLE As Long = -12&

Private m_in_in As Long, m_in_out As Long
Private m_out_in As Long, m_out_out As Long
Private m_pi As PROCESS_INFORMATION

Private m_nWaitBeforeTerminate As Long

Friend Property Get WaitBeforeTerminate() As Long
WaitBeforeTerminate = m_nWaitBeforeTerminate
End Property

Friend Property Let WaitBeforeTerminate(ByVal n As Long)
m_nWaitBeforeTerminate = n
End Property

Friend Property Get hStdIn() As Long
hStdIn = m_in_in
End Property

Friend Property Get hStdOut() As Long
hStdOut = m_out_out
End Property

Friend Property Get Handle() As Long
Handle = m_pi.hProcess
End Property

Friend Property Get ProcessId() As Long
ProcessId = m_pi.dwProcessId
End Property

Friend Function Run(ByVal lpCommandLine As String, ByVal lpCurrentDirectory As String, Optional ByVal bRedirectStdIn As Boolean, Optional ByVal bRedirectStdOut As Boolean) As Boolean
Dim si As STARTUPINFO
Dim sa As SECURITY_ATTRIBUTES
'///
If m_pi.hProcess Then Exit Function
'///create pipe
sa.nLength = Len(sa)
sa.bInheritHandle = 1
If bRedirectStdIn Then
 CreatePipe m_in_out, m_in_in, sa, 0
 SetHandleInformation m_in_in, HANDLE_FLAG_INHERIT, 0
Else
 CloseHandle m_in_in
 CloseHandle m_in_out
 m_in_in = 0
 m_in_out = 0
End If
If bRedirectStdOut Then
 CreatePipe m_out_out, m_out_in, sa, 0
 SetHandleInformation m_out_out, HANDLE_FLAG_INHERIT, 0
Else
 CloseHandle m_out_in
 CloseHandle m_out_out
 m_out_in = 0
 m_out_out = 0
End If
'///create process
si.cb = Len(si)
If bRedirectStdIn Or bRedirectStdOut Then
 si.dwFlags = STARTF_USESTDHANDLES
 si.hStdInput = m_in_out
 If m_out_in = 0 Then
  'ad-hoc!!!
  AllocConsole
  si.hStdOutput = GetStdHandle(STD_OUTPUT_HANDLE)
  si.hStdError = GetStdHandle(STD_ERROR_HANDLE)
 Else
  si.hStdOutput = m_out_in
  si.hStdError = m_out_in
 End If
End If
If CreateProcess(vbNullString, lpCommandLine, ByVal 0, ByVal 0, (bRedirectStdIn Or bRedirectStdOut) And 1&, 0, ByVal 0, lpCurrentDirectory, si, m_pi) = 0 Then
 CloseHandle m_in_in
 CloseHandle m_in_out
 m_in_in = 0
 m_in_out = 0
 CloseHandle m_out_in
 CloseHandle m_out_out
 m_out_in = 0
 m_out_out = 0
 Exit Function
End If
'///over
CloseHandle m_pi.hThread 'we don't need it
m_pi.hThread = 0
m_pi.dwThreadId = 0
Run = True
End Function

Friend Sub Detach()
If m_pi.hProcess = 0 Then Exit Sub
CloseHandle m_pi.hProcess
m_pi.hProcess = 0
'///
CloseHandle m_in_in
CloseHandle m_in_out
m_in_in = 0
m_in_out = 0
CloseHandle m_out_in
CloseHandle m_out_out
m_out_in = 0
m_out_out = 0
End Sub

Friend Function Wait(ByVal dwMilliseconds As Long) As Boolean
If m_pi.hProcess = 0 Then Exit Function
Wait = WaitForSingleObject(m_pi.hProcess, dwMilliseconds) = WAIT_TIMEOUT
End Function

Friend Function GetExitCode() As Long
Dim i As Long
If m_pi.hProcess = 0 Then Exit Function
If GetExitCodeProcess(m_pi.hProcess, i) Then GetExitCode = i
End Function

Friend Function Terminate() As Boolean
If m_pi.hProcess = 0 Then Exit Function
'///
CloseHandle m_in_in
CloseHandle m_in_out
m_in_in = 0
m_in_out = 0
CloseHandle m_out_in
CloseHandle m_out_out
m_out_in = 0
m_out_out = 0
'///
Wait m_nWaitBeforeTerminate
Terminate = TerminateProcess(m_pi.hProcess, -1) <> 0
CloseHandle m_pi.hProcess
m_pi.hProcess = 0
End Function

Friend Sub CloseStdIn()
CloseHandle m_in_in
CloseHandle m_in_out
m_in_in = 0
m_in_out = 0
End Sub

Friend Sub CloseStdOut()
CloseHandle m_out_in
CloseHandle m_out_out
m_out_in = 0
m_out_out = 0
End Sub

Private Sub Class_Terminate()
Terminate
End Sub
